home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / I-Z / Xlisp_Source.cpt / xldmem.c < prev    next >
Text File  |  1980-01-01  |  7KB  |  345 lines
  1. /* xldmem - xlisp dynamic memory management routines */
  2.  
  3. #include "xlisp.h"
  4.  
  5. /* useful definitions */
  6. #define ALLOCSIZE (sizeof(struct segment) + (anodes-1) * sizeof(NODE))
  7.  
  8. /* external variables */
  9. extern NODE *oblist,*keylist;
  10. extern NODE *xlstack;
  11. extern NODE *xlenv,*xlnewenv;
  12. extern long total;
  13. extern int anodes,nnodes,nsegs,nfree,gccalls;
  14. extern struct segment *segs;
  15. extern NODE *s_stdout;
  16. extern NODE *fnodes;
  17. extern char buf[];
  18.  
  19. /* external procedures */
  20. extern char *malloc();
  21. extern char *calloc();
  22.  
  23. /* newnode - allocate a new node */
  24. NODE *newnode(type)
  25.   int type;
  26. {
  27.     NODE *nnode;
  28.  
  29.     /* get a free node */
  30.     if ((nnode = fnodes) == NIL) {
  31.     gc();
  32.     if ((nnode = fnodes) == NIL)
  33.         xlabort("insufficient node space");
  34.     }
  35.  
  36.     /* unlink the node from the free list */
  37.     fnodes = cdr(nnode);
  38.     nfree -= 1;
  39.  
  40.     /* initialize the new node */
  41.     nnode->n_type = type;
  42.     rplacd(nnode,NIL);
  43.  
  44.     /* return the new node */
  45.     return (nnode);
  46. }
  47.  
  48. /* stralloc - allocate memory for a string adding a byte for the terminator */
  49. char *stralloc(size)
  50.   int size;
  51. {
  52.     char *sptr;
  53.  
  54.     /* allocate memory for the string copy */
  55.     if ((sptr = malloc(size+1)) == NULL) {
  56.     gc();
  57.     if ((sptr = malloc(size+1)) == NULL)
  58.         xlfail("insufficient string space");
  59.     }
  60.     total += (long) (size+1);
  61.  
  62.     /* return the new string memory */
  63.     return (sptr);
  64. }
  65.  
  66. /* strsave - generate a dynamic copy of a string */
  67. char *strsave(str)
  68.   char *str;
  69. {
  70.     char *sptr;
  71.  
  72.     /* create a new string */
  73.     sptr = stralloc(strlen(str));
  74.     strcpy(sptr,str);
  75.  
  76.     /* return the new string */
  77.     return (sptr);
  78. }
  79.  
  80. /* strfree - free string memory */
  81. strfree(str)
  82.   char *str;
  83. {
  84.     total -= (long) (strlen(str)+1);
  85.     free(str);
  86. }
  87.  
  88. /* gc - garbage collect */
  89. gc()
  90. {
  91.     NODE *p;
  92.  
  93.     /* mark all accessible nodes */
  94.     mark(oblist); mark(keylist);
  95.     mark(xlenv);
  96.     mark(xlnewenv);
  97.  
  98.     /* mark the evaluation stack */
  99.     for (p = xlstack; p; p = cdr(p))
  100.     mark(car(p));
  101.  
  102.     /* sweep memory collecting all unmarked nodes */
  103.     sweep();
  104.  
  105.     /* if there's still nothing available, allocate more memory */
  106.     if (fnodes == NIL)
  107.     addseg();
  108.  
  109.     /* count the gc call */
  110.     gccalls++;
  111. }
  112.  
  113. /* mark - mark all accessible nodes */
  114. LOCAL mark(ptr)
  115.   NODE *ptr;
  116. {
  117.     NODE *this,*prev,*tmp;
  118.  
  119.     /* just return on nil */
  120.     if (ptr == NIL)
  121.     return;
  122.  
  123.     /* initialize */
  124.     prev = NIL;
  125.     this = ptr;
  126.  
  127.     /* mark this list */
  128.     while (TRUE) {
  129.  
  130.     /* descend as far as we can */
  131.     while (TRUE) {
  132.  
  133.         /* check for this node being marked */
  134.         if (this->n_flags & MARK)
  135.         break;
  136.  
  137.         /* mark it and its descendants */
  138.         else {
  139.  
  140.         /* mark the node */
  141.         this->n_flags |= MARK;
  142.  
  143.         /* follow the left sublist if there is one */
  144.         if (livecar(this)) {
  145.             this->n_flags |= LEFT;
  146.             tmp = prev;
  147.             prev = this;
  148.             this = car(prev);
  149.             rplaca(prev,tmp);
  150.         }
  151.  
  152.         /* otherwise, follow the right sublist if there is one */
  153.         else if (livecdr(this)) {
  154.             this->n_flags &= ~LEFT;
  155.             tmp = prev;
  156.             prev = this;
  157.             this = cdr(prev);
  158.             rplacd(prev,tmp);
  159.         }
  160.         else
  161.             break;
  162.         }
  163.     }
  164.  
  165.     /* backup to a point where we can continue descending */
  166.     while (TRUE) {
  167.  
  168.         /* check for termination condition */
  169.         if (prev == NIL)
  170.         return;
  171.  
  172.         /* check for coming from the left side */
  173.         if (prev->n_flags & LEFT)
  174.         if (livecdr(prev)) {
  175.             prev->n_flags &= ~LEFT;
  176.             tmp = car(prev);
  177.             rplaca(prev,this);
  178.             this = cdr(prev);
  179.             rplacd(prev,tmp);
  180.             break;
  181.         }
  182.         else {
  183.             tmp = prev;
  184.             prev = car(tmp);
  185.             rplaca(tmp,this);
  186.             this = tmp;
  187.         }
  188.  
  189.         /* otherwise, came from the right side */
  190.         else {
  191.         tmp = prev;
  192.         prev = cdr(tmp);
  193.         rplacd(tmp,this);
  194.         this = tmp;
  195.         }
  196.     }
  197.     }
  198. }
  199.  
  200. /* sweep - sweep all unmarked nodes and add them to the free list */
  201. LOCAL sweep()
  202. {
  203.     struct segment *seg;
  204.     NODE *p;
  205.     int n;
  206.  
  207.     /* empty the free list */
  208.     fnodes = NIL;
  209.     nfree = 0;
  210.  
  211.     /* add all unmarked nodes */
  212.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  213.     p = &seg->sg_nodes[0];
  214.     for (n = seg->sg_size; n--; p++)
  215.         if (!(p->n_flags & MARK)) {
  216.         switch (ntype(p)) {
  217.         case STR:
  218.             if (p->n_strtype == DYNAMIC && p->n_str != NULL)
  219.                 strfree(p->n_str);
  220.             break;
  221.         case FPTR:
  222.             if (p->n_fp)
  223.                 fclose(p->n_fp);
  224.             break;
  225.         }
  226.         p->n_type = FREE;
  227.         p->n_flags = 0;
  228.         rplaca(p,NIL);
  229.         rplacd(p,fnodes);
  230.         fnodes = p;
  231.         nfree++;
  232.         }
  233.         else
  234.         p->n_flags &= ~(MARK | LEFT);
  235.     }
  236. }
  237.  
  238. /* addseg - add a segment to the available memory */
  239. int addseg()
  240. {
  241.     struct segment *newseg;
  242.     NODE *p;
  243.     int n;
  244.  
  245.     /* check for zero allocation */
  246.     if (anodes == 0)
  247.     return (FALSE);
  248.  
  249.     /* allocate a new segment */
  250.     if ((newseg = (struct segment *) calloc(1,ALLOCSIZE)) != NULL) {
  251.  
  252.     /* initialize the new segment */
  253.     newseg->sg_size = anodes;
  254.     newseg->sg_next = segs;
  255.     segs = newseg;
  256.  
  257.     /* add each new node to the free list */
  258.     p = &newseg->sg_nodes[0];
  259.     for (n = anodes; n--; ) {
  260.         rplacd(p,fnodes);
  261.         fnodes = p++;
  262.     }
  263.  
  264.     /* update the statistics */
  265.     total += (long) ALLOCSIZE;
  266.     nnodes += anodes;
  267.     nfree += anodes;
  268.     nsegs++;
  269.  
  270.     /* return successfully */
  271.     return (TRUE);
  272.     }
  273.     else
  274.     return (FALSE);
  275. }
  276.  
  277. /* livecar - do we need to follow the car? */
  278. LOCAL int livecar(n)
  279.   NODE *n;
  280. {
  281.     switch (ntype(n)) {
  282.     case SUBR:
  283.     case FSUBR:
  284.     case INT:
  285.     case STR:
  286.     case FPTR:
  287.         return (FALSE);
  288.     case SYM:
  289.     case LIST:
  290.     case OBJ:
  291.         return (car(n) != NIL);
  292.     default:
  293.         printf("bad node type (%d) found during left scan\n",ntype(n));
  294.         exit();
  295.     }
  296. }
  297.  
  298. /* livecdr - do we need to follow the cdr? */
  299. LOCAL int livecdr(n)
  300.   NODE *n;
  301. {
  302.     switch (ntype(n)) {
  303.     case SUBR:
  304.     case FSUBR:
  305.     case INT:
  306.     case STR:
  307.     case FPTR:
  308.         return (FALSE);
  309.     case SYM:
  310.     case LIST:
  311.     case OBJ:
  312.         return (cdr(n) != NIL);
  313.     default:
  314.         printf("bad node type (%d) found during right scan\n",ntype(n));
  315.         exit();
  316.     }
  317. }
  318.  
  319. /* stats - print memory statistics */
  320. stats()
  321. {
  322.     NODE *ofptr;
  323.     ofptr = s_stdout->n_symvalue;
  324.     sprintf(buf,"Nodes:       %d\n",nnodes);  xlputstr(ofptr,buf);
  325.     sprintf(buf,"Free nodes:  %d\n",nfree);   xlputstr(ofptr,buf);
  326.     sprintf(buf,"Segments:    %d\n",nsegs);   xlputstr(ofptr,buf);
  327.     sprintf(buf,"Allocate:    %d\n",anodes);  xlputstr(ofptr,buf);
  328.     sprintf(buf,"Total:       %ld\n",total);  xlputstr(ofptr,buf);
  329.     sprintf(buf,"Collections: %d\n",gccalls); xlputstr(ofptr,buf);
  330. }
  331.  
  332. /* xlminit - initialize the dynamic memory module */
  333. xlminit()
  334. {
  335.     /* initialize our internal variables */
  336.     anodes = NNODES;
  337.     total = 0L;
  338.     nnodes = nsegs = nfree = gccalls = 0;
  339.     fnodes = NIL;
  340.     segs = NULL;
  341.  
  342.     /* initialize structures that are marked by the collector */
  343.     xlstack = xlenv = xlnewenv = oblist = keylist = NIL;
  344. }
  345.